home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / Yerk 3.6.8 / Module source / Install < prev    next >
Encoding:
Text File  |  1995-10-14  |  17.4 KB  |  553 lines  |  [TEXT/YERK]
  1. \ 12/30/81  cbd Version 1
  2. \  2/04/86  cdn Moved in FinalSave ; added "Max Heap" button
  3. \  7/15/86  cdn Exported 
  4. \  7/17/86  cdn Added iBNDL & AddModRes
  5. \  7/28/86  cdn Added saveAppl
  6. \  6/07/91    rfl    modified for system 7 version. Works the same way as old one,
  7. \                but dictionary size refers to amount available above here.
  8. \  6/14/91    rfl    removed maxdict from module since is defined past floating point
  9. \                Instead, use msize !
  10. \                Dictionary size now means size past 'here', the current dictionary size.
  11. \  7/20/91    rfl    remove clobber for my use
  12. \ 10/17/91    rfl    easier to use for install process now. New dialog, better mem management
  13. \ 11/15/91    rfl    added readFP to saveNuc
  14. \  5/17/92    rfl    fixed cancel cosmetic problem
  15. \  5/18/93    rfl    application no longer uses Yerk file as base; it creates
  16. \                  a completely new file, copying resources out of Yerk, leaving Yerk untouched.
  17. \  5/23/93    rfl    added // sarray
  18. \  5/30/93    rfl added various frontend words so module will work with both yerk.com
  19. \                  and yerkFP.com.  Also changed ' (ticks) to 'c >body
  20. \  7/25/93    rfl    removed delete switches and added clobber switch; removed extra ctlwin code
  21. \  1/01/94    rfl    changed some ffcb calls for new file calls
  22. \  3/04/94    rfl    If creating an app, if the file already exists, delete it first.
  23. \                Max heap no longer resets stack to minstack
  24. \ 10/14/95    rfl    just added some comments about max mem size (maxdict)
  25.  
  26. Decimal
  27.  
  28. :Module iMod
  29.  
  30.  
  31. Decimal
  32.  
  33. // ctl
  34. // ctlwind
  35. // vscroll
  36. // alert
  37.  
  38. \ This is a copy of the Alert" code from "AlertQ" and "Imports"
  39. \ It is duplicated here so that ALERTMOD is not required on the install disk
  40. \ alert support
  41. \  1/01/85  cbd Version 1
  42. \  9/05/85  cdn Added disp: method
  43. \  8/22/86  cdn Renumbered alert types to correspond with IM
  44.  
  45. 0 Variable tALRT here +base tALRT !
  46.     100 w, 51 w, 191 w, 462 w, 0 w, $ 7fff w,
  47.  
  48. 0 Variable tDITL here +base tDITL !
  49.     2 w,    \ # items-1
  50.     0,  58 w, 177 w,  80 w, 234 w,   4 c, 2 c, 'type ..OK w,
  51.     0,  60 w, 355 w,  81 w, 393 w, 136 c, 4 c, 'type 0000 ,
  52.     0,  10 w,  76 w,  42 w, 393 w, 136 c,
  53.  
  54. 3 Alert Alrt
  55.  
  56. \ Display alert using message saved in-line
  57. : (Al") { RC type -- }
  58.     RC
  59.     IF    \ build ALRT from scratch
  60.             12 newHandle        
  61.             dup 'type ALRT word0 nullOSstr call AddResource
  62.             >ptr tALRT 4+ swap 12 cMove
  63.         \ build DITL from scratch
  64.             R dup c@ align 50 + newHandle
  65.             dup 'type DITL word0 nullOSstr call AddResource
  66.             tDITL 36 + 4 blanks
  67.             RC s->d swap over dabs <# #s sign #> tDITL 36 + swap 4 min cMove
  68.             >ptr tDITL 4+ over 49 cMove
  69.             49 + over c@ 1+ cMove
  70.         arrowcurs
  71.         0 type disp: alrt
  72.         0 GetRes ALRT dup call RmveResource call ReleaseResource
  73.         0 GetRes DITL dup call RmveResource call ReleaseResource
  74.         type 0 max 3 min exec: Aact
  75.     THEN
  76.     R c@ 1+ align R> + >R
  77. ;
  78.  
  79. \ ( RC type : str" -- )  Compile conditional alert box
  80. : Alert"
  81.     ?comp Compile (al") word" c@ 1+ Align allot
  82. ; Immediate
  83.  
  84. : copyRsrc { id type \ hndl -- hndl } id type (getres) -> hndl
  85.         hndl call detachResource
  86.         hndl type id makeint nullOSStr call addResource hndl ;
  87.  
  88. 0 Value curStack
  89. 0 Value curDict
  90.  
  91. 8400 constant minHeap    \ can't set heap to less than this amt
  92. 52 constant stVal        \ 52 from location in nuc
  93.  
  94. \ ( handle -- handle )  mark the resource for update to disk
  95. : ChR dup call ChangedResource ;
  96.  
  97. : unlockSeg 2 getres CODE unlock ;
  98. : lockSeg 2 getres CODE lock ;
  99.  
  100. : readFP " fpInit" sFind
  101.     IF 2drop 5 'type CODE (getres) dup >ptr 'f> rot 0 swap call SizeResource cmove 
  102.     THEN ;
  103.  
  104. 2 constant IsApplication
  105. \ Save the current Yerk Code resource
  106. : saveCode2
  107.     2 GetRes CODE call ChangedResource    \ Mark nucleus for writing
  108.     word0 call ResError i->l 0 Alert" nucleus write error"
  109.     clear: ffcb
  110.     tib 410 erase        \ tib, num output, pad, aRegn
  111. \    0 msize !
  112.     cflush call ExitToShell ;    \ Causes nuc changes to be written, but first flush cache
  113.  
  114. \ Save CODE 2 resource without dictionary
  115. : saveNuc 
  116.     'c .s >body nfa dup 8 ! 12 !        \ assumes .s is last definition in nuc
  117.                                 \  store into initLast and initFenc (lastdef)
  118.     16 24 erase                    \ clear user initialization data
  119.                             \ but keep whatever is in msize
  120.     'c (key) 'c abort 20 + !        \ use primitive (key) again
  121.                                 \ assumes abort is original abort (16 offset)
  122.     readFP 
  123.     begin-dp @ 2- (codezone) saveCode2 ;
  124.  
  125. \ Save CODE 2 resource with dictionary; eliminating loaduser code
  126. : saveAppl
  127.     IsApplication 1 getres CODE >ptr 6 + c!        \ flag loader code that this is an appl.
  128.     1 'type CODE copyRsrc dup w 48 call setResAttrs chr call WriteResource
  129.     word0 call ResError i->l 0 Alert" code 1 write error"
  130.     0 'type CODE copyRsrc dup w 32 call setResAttrs chr call WriteResource
  131.     word0 call ResError i->l 0 Alert" code 0 write error"    
  132.     readFP
  133. \      $ 4e714e71 noload ! \ a nono, patch code, but we will flush the cache
  134.     cflush
  135.     0 ' iMod 8+ !        \ protect install code from purge
  136.     purge                \ purge all modules
  137.     0 -> path
  138.     fwind -> actw        \ set active window ptr to fwind, not iwind
  139.     $ 10000 here curDict + - 0 max allot    \ meet 64K boundary requirement
  140.     here  unlockSeg (codezone) lockSeg  
  141.     2 'type CODE copyRsrc w 48 call setResAttrs saveCode2 ;    \ save just enough
  142.  
  143. \ fetch starting stack headroom for this nucleus
  144. : @stack  stVal @ negate ;
  145. : !stack  curStack negate stVal ! ;
  146.  
  147. \ fetch starting heap size for this nucleus
  148. : @heap    s0 @stack -  begin-dp @ - msize @ - ;
  149.  
  150. \ determine amount of heap available for current configuration
  151. : curHeap  @heap @stack curStack - + room curDict - +  ;
  152.  
  153. \ set nucleus minimum heap value - no longer necessary
  154. : !heap  ; \  curHeap  mpatch ! ;
  155.  
  156. Decimal
  157.  
  158. : Closer  close: caller ;
  159.  
  160. Int theItem
  161. Var itemHandle
  162. Int itemType
  163.  
  164. 0 value rtm
  165.  
  166. :CLASS  Dialog  <Super X-Array
  167.  
  168.     Int        Resid
  169.     Var        dialPtr
  170.     Var        procPtr
  171.     Int        boldItem
  172.  
  173.     \ ( -- )
  174.     :M  CLOSE:  get: dialPtr  call DisposDialog   ;M
  175.  
  176.     :M  SET: get: dialPtr call setPort ;M
  177.  
  178.     \ ( item# -- hndl )  get handle for item#
  179.     :M  HANDLE:  { item# -- hndl }  get: dialPtr  item# makeInt
  180.         abs: itemType  abs: itemHandle  abs: tempRect
  181.         call GetDItem get: itemHandle  ;M
  182.  
  183.     \ draws the frame around the hilit item
  184.     :M  FRAME:     get: boldItem -dup
  185.         IF    savePort get: dialPtr call SetPort 3 3 pack call PenSize
  186.             handle: self drop -4 -4 inset: tempRect
  187.             abs: tempRect 16 16 pack call FrameRoundRect call penNormal restPort
  188.         THEN ;M
  189.  
  190.     \ ( -- )  create dialog from resID
  191.     :M  GETNEW:  0 int: resid 0 -1  call GetNewDialog put: dialPtr
  192.         frame: self    ;M
  193.  
  194.     :M  SHOW: get: dialPtr call showWindow frame: self ;M
  195.  
  196.     \ ( cfa -- )  set dialog proc
  197.     :M  SETPROC: >body put: procPtr ;M
  198.  
  199.     \ ( -- )  display as modal dialog
  200.     :M  MODAL:
  201.         BEGIN
  202.             get: procPtr dup IF +base THEN abs: theItem call ModalDialog
  203.             get: theItem ( 1-) exec: super
  204.             rtm
  205.         WHILE
  206.             0 -> rtm    \ iterate every time ReturnToModal is executed
  207.         REPEAT
  208.     ;M
  209.  
  210.     \ ( act0 ... actN -- )  set the dialog's action handlers starting at element 1
  211.     :M  ACTIONS: ?ixobj limit 1- 0
  212.         DO limit i- 1- (^elem) !
  213.         LOOP   ;M
  214.  
  215.     \ ( val item# -- )
  216.     :M  PUT:  handle: self  swap makeInt call SetCtlValue   ;M
  217.  
  218.     \ ( item# -- val ) get value for an item#
  219.     :M  GET:   handle: self  >R word0 R>
  220.         call GetCtlValue word0  ;M    \ added word0 cbd 7/17/85
  221.  
  222.     \ ( resID -- )  Associate object with its resource
  223.     :M  INIT:  put: resID   ;M
  224.  
  225.     \ ( item# -- )  Causes bold outline of the specified item
  226.     :M  HILITE: put: boldItem ;M
  227.  
  228.     \ ( item# -- addr len )  return a text item's text
  229.     :M  GETTEXT: handle: self  buf255 +base   get: ItemType dup 24 and
  230.         IF   drop call GetIText
  231.         ELSE 4 and
  232.              IF   call GetCTitle
  233.              ELSE 2drop 0 buf255 c!        \ user item has no text
  234.             THEN
  235.         THEN
  236.         buf255 count  ;M
  237.  
  238.     \ ( addr len item# -- )  store an item's text
  239.     :M  PUTTEXT: { addr len item# -- } item#  handle: self
  240.         addr len str255   get: ItemType dup 24 and
  241.         IF   drop call SetIText
  242.         ELSE 4 and
  243.              IF   call SetCTitle
  244.              ELSE 2drop                    \ user item has no text
  245.              THEN
  246.         THEN   ;M
  247.  
  248.     \ ( start end item# )  set selection range for text item
  249.     :M  SETSELECT:  { start end item# -- }  get: dialPtr
  250.         item# makeInt start end pack  call SeliText  ;M
  251.  
  252.     \ ( -- )  force drawing of dialog before going to modal:
  253.     :M  DRAW:   get: dialPtr call DrawDialog ;M
  254.  
  255.     \  set user item into dialog; userItem must start with rectangle data
  256.     :M  SETUSERITEM: { userItem -- }
  257.         get: dialPtr getParms: userItem abs: userItem call setDItem ;M
  258.  
  259.     \ ( -- )  Initialize default handlers to close the dialog box
  260.     :M  CLASSINIT:  limit 0 DO 'c closer i to: self LOOP  ;M
  261.  
  262. ;CLASS
  263.  
  264. \ signal modal method to re-enter ModalDialog
  265. : ReturnToModal
  266.     1 -> rtm ;
  267.  
  268. \ Toggle the check box or radio button
  269. : togItem
  270.     get: theItem 1 over get: caller - swap put: caller
  271.     ReturnToModal
  272. ;
  273.  
  274. \ ( addr0 len0 addr1 len1 addr2 len2 addr3 len3 -- )  Substitute Dialog text
  275. : ParamText { \ p1 p2 p3 -- }
  276.      str255 dup -> p3   -base count +
  277.     >str255 dup -> p2   -base count +
  278.     >str255 dup -> p1   -base count +
  279.     >str255     p1 p2 p3 call ParamText
  280. ;
  281.  
  282. 16 dialog iDlg
  283. 111 init: iDlg
  284. 1 hilite: iDlg
  285.  
  286. \ ( addr1 len1 addr2 len2 -- )  Install informatory message
  287. : iMsg    "  " "  " ParamText draw: iDlg ;
  288.  
  289. \ need to load this because sarray is in different
  290. \ locations in yerk.com and yerkFP.com
  291. // pathList
  292. forget getptxt
  293. // listman
  294.  
  295. \ install a resource type module
  296. : AddModRes { mdef arg \ resID -- }
  297.     mdef @ modCode <> IF exit THEN
  298.      mdef indexOf: nMods IF drop ELSE exit THEN
  299.     mdef >name n>count binName name: fFcb
  300.     openReadOnly: fFcb IF exit THEN
  301.     mdef 12 + dup @ $ 7fffffff and killPtr        \ mask out keep bit and kill
  302.     0 swap !                                    \ don't care about keep anymore 
  303.     " Module:" getName: fFcb iMsg
  304.     size: fFcb align new: mHndl    \ Create a new handle for this module
  305.     ptr: mHndl size: mHndl  read: fFcb 0 Alert" Module read failed"
  306.     close: fFcb drop
  307.     word0 'type CODE call UniqueID i->l -> resID
  308.     get: mHndl dup 'type CODE resID makeInt        \ Create new Module resource
  309.     mdef >name n>count str255 call AddResource
  310.     dup w 16 call SetResAttrs                    \ mark resource locked
  311.     ChR call WriteResource                        \ write it to application file
  312.     word0 call ResError i->l 0 Alert" Module rsrc write failed.  Check disk space or try Delete modules option."
  313.     resID mdef 22 + w!                            \ store module resID
  314. \    14 get: iDlg IF delete: fFcb drop THEN        \ free up disk space?
  315. ;
  316.  
  317. \ ( item# -- )
  318. : invWord errbeep 0 $ ffff rot setSelect: iDlg ReturnToModal ;
  319.  
  320. \ ( -- True )  validate quit & abort words; if bad return to modal
  321. : okBtn \ { \ qv -- }
  322.     10 getText: iDlg sFind 0= IF 10 invWord exit THEN
  323.     drop cfa -> quitVec
  324.     11 getText: iDlg sFind 0= IF 11 invWord exit THEN
  325.     drop cfa -> abortVec
  326.     12 getText: iDlg sFind 0= IF 12 invWord exit THEN
  327.     drop cfa -> objInit
  328.     True
  329. ;
  330.  
  331. 11 'cfas okBtn False null null null null null null null null null
  332. 4 'cfas null togItem togItem togItem
  333. actions: iDlg
  334.  
  335. Int apRefNum
  336. Var apParam
  337. String applName
  338.  
  339. : getR
  340.     128 GetRes BNDL >ptr @ sp@ 4 3 putText: iDlg
  341.     0 swap (GetRes) >ptr count   4 putText: iDlg
  342.     buf255 +base abs: apRefNum abs: apParam call GetAppParms
  343.     buf255 count 2dup            5 putText: iDlg put: applName
  344.     129 GetRes FREF >ptr @ sp@ 4 6 putText: iDlg drop
  345.     130 GetRes FREF >ptr @ sp@ 4 7 putText: iDlg drop
  346.     131 GetRes FREF >ptr @ sp@ 4 8 putText: iDlg drop
  347.     132 GetRes FREF >ptr @ sp@ 4 9 putText: iDlg drop
  348. ;
  349.  
  350. \ ( addr len -- (addr) )  fetch 1st four bytes on an odd byte, pad with blanks
  351. : drop@ >R sp@ $ 20202020 rot rot R> 4 min cMove ;
  352.  
  353.  
  354. : putR
  355.     128 'type BNDL copyRsrc dup call writeResource put: mHndl
  356.     3 getText: iDlg drop@ dup ptr: mHndl !    ( newSig to BNDL)
  357.     get: mHndl call changedResource
  358.     get: applName name: fFcb 'type APPL over set: fFcb
  359.     4 getText: iDlg dup 1+ align new: mHndl        ( newSig addr len )
  360.       str255 -base ptr: mHndl over c@ 1+ cMove    ( newSig )
  361.       get: mHndl swap word0 nullOSstr call AddResource get: mHndl call writeResource
  362.     10 5 DO i getText: iDlg drop@ 129 getres FREF >ptr !
  363.             123 i+ 'type FREF copyRsrc dup w 32 call setResAttrs
  364.             chr call writeResource
  365.          LOOP
  366.     13 get: iDlg 8 << 256 getres WIND >ptr 10 + w!
  367.      256 'type WIND copyRsrc call writeResource
  368.     133 128 DO i 'type ICN# copyRsrc dup
  369.                w 32 call setResAttrs chr
  370.                call writeResource
  371.             LOOP
  372.     1 'type vers copyRsrc call writeResource
  373.     -1 'type SIZE copyRsrc call writeResource
  374. ;
  375.  
  376.  
  377. \ Set the maximum dictionary size that Yerk will allow
  378. \ on a large memory Mac.  This is done so that on a large system, more heap
  379. \ will be available for modules, etc. than the amount set for a small
  380. \ machine (~22K). The heap is given whatever is left over from the maximum
  381. \ dictionary size, down to a minimum of the value set in Install.
  382. \ You should do a Save using Install after setting this value to save the
  383. \ Yerk nucleus file to disk.
  384. \ ( max-bytes -- )
  385. \ : maxDict  msize ! ;
  386.  
  387. \ set dictionary heap and stack to selected values
  388. \ for apps, the old dictionary had become the new nucleus
  389. : setMem here curDict + ( begin-dp @ -) msize ! ( !heap) !stack
  390.     here 4+ msize 12 - ! \ store new initdp, leave 4 bytes room at end
  391.     latest 8 ! ;        \ store last definition
  392.     
  393.  
  394. \ clobber name fields in nucleus - can't clobber in entire dictionary
  395. \  without leaving :proc definitions intact because of the way initProcs
  396. \  searches the dictionary.
  397. : killName  n>count 1 fill ;
  398. : clobber  'c cold >body nfa
  399.     BEGIN  dup killName  pfa lfa @ dup 'c fWind >body nfa =
  400.     UNTIL drop   ;
  401.  
  402. \ This will clobber the entire dictionary. This could be fatal if your code
  403. \   does a search of the dictionary at runtime. For that reason, this code
  404. \   is not used here.
  405. \ : (clobber)  ( mycfa parm --)  drop >body nfa killName ;
  406. \ : clobber 'c (clobber) 0 trav ;
  407.  
  408. 1 Value icurs
  409.  
  410. : iBNDL 
  411.     'c bye 0 to: Aact    \ Alert action
  412.     new: applName
  413.     getnew: iDlg
  414.     getR
  415.     " NULW" 10 putText: iDlg
  416.     " fpInit" sFind IF 2drop " CLEANFLOAT" ELSE " CLEAN2" THEN
  417.     11 putText: iDlg
  418.     latest n>count 12 putText: iDlg    \ ******
  419.     0 $ ffff 5 setSelect: iDlg
  420.     modal: iDlg
  421.     IF    watchcurs
  422.         5 getText: iDlg    2dup put: applName    \ get new filename
  423.         str255 call createResFile            \ create new file by that name
  424.         word0 call ResError i->l -48 =        \ if file already exists, delete it
  425.         IF new: loadfile get: applName name: topfile
  426.             delete: topfile remove: loadfile
  427.             get: applName str255 call createResFile
  428.         THEN
  429.         5 getText: iDlg name: fFcb             \ want to set finder flags
  430.         getfileinfo: ffcb 0 Alert" getfileinfo error"
  431.         ffcb 40 + w@ $ 2100 or ffcb 40 + w!    \ set bndl bit and init bit
  432.         setFileInfo: ffcb 0 Alert" setfileinfo error"
  433.         lock: applName
  434.         word0 get: applName str255 unlock: applName
  435.         call openResFile i->l 0< not
  436.         IF putR                    \ store new resources
  437.             " Installing ^0 ^1" 23 putText: iDlg
  438.             'c AddModRes 0 trav        \ Convert modules on this disk into resources
  439.             " Dictionary" "  " iMsg
  440.             init: loadFile
  441. \            15 get: iDlg IF get: imageName name: fFcb delete: fFcb drop THEN
  442.             14 get: iDlg IF clobber THEN        \ fsecure nucleus
  443.             setMem saveAppl                        \ save application
  444.         ELSE close: iDlg 1 1 alert" couldn't open appl resource file" abort
  445.         THEN
  446.     THEN
  447.     release: applName
  448.     close: iDlg
  449.     'c IMOD mUnlock 'c abort 0 to: Aact icurs -> curs set: fwind become quit ;
  450.  
  451.  
  452. vScroll vs1
  453. vScroll vs2
  454.  
  455. Control saveBtn
  456. Control instBtn
  457. Control canBtn
  458. Control heapBtn
  459.  
  460. Control mxSt  radioID  init: mxSt
  461. Control miSt  radioID  init: miSt
  462. Control mxDi  radioID  init: mxDi
  463. Control miDi  radioID  init: miDi
  464.  
  465. \ Rectangles for formatting screen
  466. Rect stRect    \ stack headroom
  467. 20 20 170 40 put: stRect
  468. Rect hpRect    \ heap start size
  469. 20 45 170 65 put: hpRect
  470. Rect diRect    \ Dictionary headroom
  471. 20 70 170 90 put: diRect
  472.  
  473. rect wRect
  474. 100 40 400 170 put: wRect
  475.  
  476. \ get current limits for stack and dict based on minHeap
  477. : maxiStack  curStack curHeap minHeap - + ;
  478. : maxiDict   curDict  curHeap minHeap - + ;
  479. 9000 value minStack
  480.  128 value minDict
  481.  
  482. \ print number in rect
  483. : .Val  { n theRect -- }  tempRect =: theRect
  484.     4 4 inset: tempRect 100 putTopX: tempRect clear: tempRect
  485.     104 getboty: tempRect  gotoxy n 7 .r  ;
  486.  
  487. : .vs1  curStack stRect .val curHeap hpRect .val ;
  488. : .vs2  curDict  diRect .val curHeap hpRect .val ;
  489.  
  490. : drawIwind  draw: stRect draw: hpRect draw: diRect
  491.    2 tmode 0 tfont 12 tsize
  492.    24 36 gotoxy ." Stack:"
  493.    24 61 gotoxy ." Heap:"
  494.    24 86 gotoxy ." Dictionary:"  .vs1 .vs2  ;
  495.  
  496. \ Define the Install utility window
  497. ctlWind iWind
  498. 4 'cfas  null null drawIwind null actions: iWind
  499.  
  500. \ listen to mouse and drop keys
  501. : listener  BEGIN key drop AGAIN  ;
  502.  
  503. \ Create new window, controls
  504. : Install
  505.     wRect "  " dlgWind True False new: iWind
  506.     180 15 33 iWind new: vs1  180 65 33 iWind new: vs2
  507.     2000 32000 putRange: vs1  0 8000 putRange: vs2
  508.     4000 dup put: vs1  put: vs2
  509.     @stack -> curStack  room -> curDict
  510.     197 14 " ++" iWind new: mxSt
  511.     197 30 " --" iWind new: miSt
  512.     197 64 " ++" iWind new: mxDi
  513.     197 80 " --" iWind new: miDi
  514.     238 20 " Save" iWind new: saveBtn
  515.     236 45 " Install" iWind new: instBtn
  516.     236 70 " Cancel" iWind new: canBtn
  517.     150 105 " Max Heap" iWind new: heapBtn
  518.     update: iWind   curs -> icurs -curs
  519.     Become listener ;
  520.  
  521. : stDn  curStack 8 - minStack max -> curStack  .vs1  ;
  522. : stUp  curStack 8+  maxiStack min -> curStack  .vs1  ;
  523.  
  524. : diDn  curDict 32 -  minDict max -> curDict  .vs2  ;
  525. : diUp  curDict 32 +  maxiDict min -> curDict  .vs2  ;
  526.  
  527. 5 'cfas stUp stDn null null null actions: vs1
  528. 5 'cfas diUp diDn null null null actions: vs2
  529.  
  530. : config   curDict here + begin-dp @ - msize ! ( !heap) !stack  saveNuc ;
  531. : wInstall close: iWind buildmodWind  ;
  532. : cancel   close: iWind 'c IMOD mUnlock icurs -> curs set: fwind become quit ;
  533.  
  534.  
  535. : doMxSt  curStack 512 + maxiStack min -> curStack .vs1 ;
  536. : doMiSt  curStack 512 - minStack max -> curStack .vs1 ;
  537. : doMxDi  curDict 8192 + maxiDict min -> curDict .vs2 ;
  538. : doMiDi  curDict 8192 - minDict max -> curDict .vs2 ;
  539. : doMxHp  ( minStack -> curStack ) .vs1  minDict -> curDict .vs2 ;
  540. : buildInstall acceptSelect iBndl ;
  541. 'c BuildInstall actions: selectBut
  542.  
  543. 'c config   actions: saveBtn
  544. 'c wInstall actions: instBtn
  545. 'c cancel   actions: canBtn
  546. 'c doMxSt   actions: mxSt
  547. 'c doMiSt   actions: miSt
  548. 'c doMxDi   actions: mxDI
  549. 'c doMiDi   actions: miDi
  550. 'c doMxHp   actions: heapBtn
  551.  
  552. ;Module
  553.